home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / tcl / tcl70b2.lha / tcl7.0b2 / tests / trace.test < prev    next >
Text File  |  1993-06-16  |  28KB  |  915 lines
  1. # Commands covered:  trace
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27. # $Header: /user6/ouster/tcl/tests/RCS/trace.test,v 1.18 93/06/16 10:54:54 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30.  
  31. proc traceScalar {name1 name2 op} {
  32.     global info
  33.     set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
  34. }
  35. proc traceArray {name1 name2 op} {
  36.     global info
  37.     set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg]
  38. }
  39. proc traceProc {name1 name2 op} {
  40.     global info
  41.     set info [concat $info [list $name1 $name2 $op]]
  42. }
  43. proc traceTag {tag args} {
  44.     global info
  45.     set info [concat $info $tag]
  46. }
  47. proc traceError {args} {
  48.     error "trace returned error"
  49. }
  50. proc traceCheck {cmd args} {
  51.     global info
  52.     set info [list [catch $cmd msg] $msg]
  53. }
  54. proc traceCrtElement {value name1 name2 op} {
  55.     uplevel set ${name1}($name2) $value
  56. }
  57.  
  58. # Read-tracing on variables
  59.  
  60. test trace-1.1 {trace variable reads} {
  61.     catch {unset x}
  62.     set info {}
  63.     trace var x r traceScalar
  64.     list [catch {set x} msg] $msg $info
  65. } {1 {can't read "x": no such variable} {x {} r 1 {can't read "x": no such variable}}}
  66. test trace-1.2 {trace variable reads} {
  67.     catch {unset x}
  68.     set x 123
  69.     set info {}
  70.     trace var x r traceScalar
  71.     list [catch {set x} msg] $msg $info
  72. } {0 123 {x {} r 0 123}}
  73. test trace-1.3 {trace variable reads} {
  74.     catch {unset x}
  75.     set info {}
  76.     trace var x r traceScalar
  77.     set x 123
  78.     set info
  79. } {}
  80. test trace-1.4 {trace array element reads} {
  81.     catch {unset x}
  82.     set info {}
  83.     trace var x(2) r traceArray
  84.     list [catch {set x(2)} msg] $msg $info
  85. } {1 {can't read "x(2)": no such element in array} {x 2 r 1 {can't read "x(2)": no such element in array}}}
  86. test trace-1.5 {trace array element reads} {
  87.     catch {unset x}
  88.     set x(2) zzz
  89.     set info {}
  90.     trace var x(2) r traceArray
  91.     list [catch {set x(2)} msg] $msg $info
  92. } {0 zzz {x 2 r 0 zzz}}
  93. test trace-1.6 {trace reads on whole arrays} {
  94.     catch {unset x}
  95.     set info {}
  96.     trace var x r traceArray
  97.     list [catch {set x(2)} msg] $msg $info
  98. } {1 {can't read "x(2)": no such variable} {}}
  99. test trace-1.7 {trace reads on whole arrays} {
  100.     catch {unset x}
  101.     set x(2) zzz
  102.     set info {}
  103.     trace var x r traceArray
  104.     list [catch {set x(2)} msg] $msg $info
  105. } {0 zzz {x 2 r 0 zzz}}
  106. test trace-1.8 {trace variable reads} {
  107.     catch {unset x}
  108.     set x 444
  109.     set info {}
  110.     trace var x r traceScalar
  111.     unset x
  112.     set info
  113. } {}
  114.  
  115. # Basic write-tracing on variables
  116.  
  117. test trace-2.1 {trace variable writes} {
  118.     catch {unset x}
  119.     set info {}
  120.     trace var x w traceScalar
  121.     set x 123
  122.     set info
  123. } {x {} w 0 123}
  124. test trace-2.2 {trace writes to array elements} {
  125.     catch {unset x}
  126.     set info {}
  127.     trace var x(33) w traceArray
  128.     set x(33) 444
  129.     set info
  130. } {x 33 w 0 444}
  131. test trace-2.3 {trace writes on whole arrays} {
  132.     catch {unset x}
  133.     set info {}
  134.     trace var x w traceArray
  135.     set x(abc) qq
  136.     set info
  137. } {x abc w 0 qq}
  138. test trace-2.4 {trace variable writes} {
  139.     catch {unset x}
  140.     set x 1234
  141.     set info {}
  142.     trace var x w traceScalar
  143.     set x
  144.     set info
  145. } {}
  146. test trace-2.5 {trace variable writes} {
  147.     catch {unset x}
  148.     set x 1234
  149.     set info {}
  150.     trace var x w traceScalar
  151.     unset x
  152.     set info
  153. } {}
  154.  
  155. # Basic unset-tracing on variables
  156.  
  157. test trace-3.1 {trace variable unsets} {
  158.     catch {unset x}
  159.     set info {}
  160.     trace var x u traceScalar
  161.     catch {unset x}
  162.     set info
  163. } {x {} u 1 {can't read "x": no such variable}}
  164. test trace-3.2 {variable mustn't exist during unset trace} {
  165.     catch {unset x}
  166.     set x 1234
  167.     set info {}
  168.     trace var x u traceScalar
  169.     unset x
  170.     set info
  171. } {x {} u 1 {can't read "x": no such variable}}
  172. test trace-3.3 {unset traces mustn't be called during reads and writes} {
  173.     catch {unset x}
  174.     set info {}
  175.     trace var x u traceScalar
  176.     set x 44
  177.     set x
  178.     set info
  179. } {}
  180. test trace-3.4 {trace unsets on array elements} {
  181.     catch {unset x}
  182.     set x(0) 18
  183.     set info {}
  184.     trace var x(1) u traceArray
  185.     catch {unset x(1)}
  186.     set info
  187. } {x 1 u 1 {can't read "x(1)": no such element in array}}
  188. test trace-3.5 {trace unsets on array elements} {
  189.     catch {unset x}
  190.     set x(1) 18
  191.     set info {}
  192.     trace var x(1) u traceArray
  193.     unset x(1)
  194.     set info
  195. } {x 1 u 1 {can't read "x(1)": no such element in array}}
  196. test trace-3.6 {trace unsets on array elements} {
  197.     catch {unset x}
  198.     set x(1) 18
  199.     set info {}
  200.     trace var x(1) u traceArray
  201.     unset x
  202.     set info
  203. } {x 1 u 1 {can't read "x(1)": no such variable}}
  204. test trace-3.7 {trace unsets on whole arrays} {
  205.     catch {unset x}
  206.     set x(1) 18
  207.     set info {}
  208.     trace var x u traceProc
  209.     catch {unset x(0)}
  210.     set info
  211. } {}
  212. test trace-3.8 {trace unsets on whole arrays} {
  213.     catch {unset x}
  214.     set x(1) 18
  215.     set x(2) 144
  216.     set x(3) 14
  217.     set info {}
  218.     trace var x u traceProc
  219.     unset x(1)
  220.     set info
  221. } {x 1 u}
  222. test trace-3.9 {trace unsets on whole arrays} {
  223.     catch {unset x}
  224.     set x(1) 18
  225.     set x(2) 144
  226.     set x(3) 14
  227.     set info {}
  228.     trace var x u traceProc
  229.     unset x
  230.     set info
  231. } {x {} u}
  232.  
  233. # Trace multiple trace types at once.
  234.  
  235. test trace-4.1 {multiple ops traced at once} {
  236.     catch {unset x}
  237.     set info {}
  238.     trace var x rwu traceProc
  239.     catch {set x}
  240.     set x 22
  241.     set x
  242.     set x 33
  243.     unset x
  244.     set info
  245. } {x {} r x {} w x {} r x {} w x {} u}
  246. test trace-4.2 {multiple ops traced on array element} {
  247.     catch {unset x}
  248.     set info {}
  249.     trace var x(0) rwu traceProc
  250.     catch {set x(0)}
  251.     set x(0) 22
  252.     set x(0)
  253.     set x(0) 33
  254.     unset x(0)
  255.     unset x
  256.     set info
  257. } {x 0 r x 0 w x 0 r x 0 w x 0 u}
  258. test trace-4.3 {multiple ops traced on whole array} {
  259.     catch {unset x}
  260.     set info {}
  261.     trace var x rwu traceProc
  262.     catch {set x(0)}
  263.     set x(0) 22
  264.     set x(0)
  265.     set x(0) 33
  266.     unset x(0)
  267.     unset x
  268.     set info
  269. } {x 0 w x 0 r x 0 w x 0 u x {} u}
  270.  
  271. # Check order of invocation of traces
  272.  
  273. test trace-5.1 {order of invocation of traces} {
  274.     catch {unset x}
  275.     set info {}
  276.     trace var x r "traceTag 1"
  277.     trace var x r "traceTag 2"
  278.     trace var x r "traceTag 3"
  279.     catch {set x}
  280.     set x 22
  281.     set x
  282.     set info
  283. } {3 2 1 3 2 1}
  284. test trace-5.2 {order of invocation of traces} {
  285.     catch {unset x}
  286.     set x(0) 44
  287.     set info {}
  288.     trace var x(0) r "traceTag 1"
  289.     trace var x(0) r "traceTag 2"
  290.     trace var x(0) r "traceTag 3"
  291.     set x(0)
  292.     set info
  293. } {3 2 1}
  294. test trace-5.3 {order of invocation of traces} {
  295.     catch {unset x}
  296.     set x(0) 44
  297.     set info {}
  298.     trace var x(0) r "traceTag 1"
  299.     trace var x r "traceTag A1"
  300.     trace var x(0) r "traceTag 2"
  301.     trace var x r "traceTag A2"
  302.     trace var x(0) r "traceTag 3"
  303.     trace var x r "traceTag A3"
  304.     set x(0)
  305.     set info
  306. } {A3 A2 A1 3 2 1}
  307.  
  308. # Check effects of errors in trace procedures
  309.  
  310. test trace-6.1 {error returns from traces} {
  311.     catch {unset x}
  312.     set x 123
  313.     set info {}
  314.     trace var x r "traceTag 1"
  315.     trace var x r traceError
  316.     list [catch {set x} msg] $msg $info
  317. } {1 {can't read "x": trace returned error} {}}
  318. test trace-6.2 {error returns from traces} {
  319.     catch {unset x}
  320.     set x 123
  321.     set info {}
  322.     trace var x w "traceTag 1"
  323.     trace var x w traceError
  324.     list [catch {set x 44} msg] $msg $info
  325. } {1 {can't set "x": trace returned error} {}}
  326. test trace-6.3 {error returns from traces} {
  327.     catch {unset x}
  328.     set x 123
  329.     set info {}
  330.     trace var x u "traceTag 1"
  331.     trace var x u traceError
  332.     list [catch {unset x} msg] $msg $info
  333. } {0 {} 1}
  334. test trace-6.4 {error returns from traces} {
  335.     catch {unset x}
  336.     set x(0) 123
  337.     set info {}
  338.     trace var x(0) r "traceTag 1"
  339.     trace var x r "traceTag 2"
  340.     trace var x r traceError
  341.     trace var x r "traceTag 3"
  342.     list [catch {set x(0)} msg] $msg $info
  343. } {1 {can't read "x(0)": trace returned error} 3}
  344. test trace-6.5 {error returns from traces} {
  345.     catch {unset x}
  346.     set x 123
  347.     trace var x u traceError
  348.     list [catch {unset x} msg] $msg
  349. } {0 {}}
  350. test trace-6.6 {error returns from traces} {
  351.     # This test just makes sure that the memory for the error message
  352.     # gets deallocated correctly when the trace is invoked again or
  353.     # when the trace is deleted.
  354.     catch {unset x}
  355.     set x 123
  356.     trace var x r traceError
  357.     catch {set x}
  358.     catch {set x}
  359.     trace vdelete x r traceError
  360. } {}
  361.  
  362. # Check to see that variables are expunged before trace
  363. # procedures are invoked, so trace procedure can even manipulate
  364. # a new copy of the variables.
  365.  
  366. test trace-7.1 {be sure variable is unset before trace is called} {
  367.     catch {unset x}
  368.     set x 33
  369.     set info {}
  370.     trace var x u {traceCheck {uplevel set x}}
  371.     unset x
  372.     set info
  373. } {1 {can't read "x": no such variable}}
  374. test trace-7.2 {be sure variable is unset before trace is called} {
  375.     catch {unset x}
  376.     set x 33
  377.     set info {}
  378.     trace var x u {traceCheck {uplevel set x 22}}
  379.     unset x
  380.     concat $info [list [catch {set x} msg] $msg]
  381. } {0 22 0 22}
  382. test trace-7.3 {be sure traces are cleared before unset trace called} {
  383.     catch {unset x}
  384.     set x 33
  385.     set info {}
  386.     trace var x u {traceCheck {uplevel trace vinfo x}}
  387.     unset x
  388.     set info
  389. } {0 {}}
  390. test trace-7.4 {set new trace during unset trace} {
  391.     catch {unset x}
  392.     set x 33
  393.     set info {}
  394.     trace var x u {traceCheck {global x; trace var x u traceProc}}
  395.     unset x
  396.     concat $info [trace vinfo x]
  397. } {0 {} {u traceProc}}
  398.  
  399. test trace-8.1 {make sure array elements are unset before traces are called} {
  400.     catch {unset x}
  401.     set x(0) 33
  402.     set info {}
  403.     trace var x(0) u {traceCheck {uplevel set x(0)}}
  404.     unset x(0)
  405.     set info
  406. } {1 {can't read "x(0)": no such element in array}}
  407. test trace-8.2 {make sure array elements are unset before traces are called} {
  408.     catch {unset x}
  409.     set x(0) 33
  410.     set info {}
  411.     trace var x(0) u {traceCheck {uplevel set x(0) zzz}}
  412.     unset x(0)
  413.     concat $info [list [catch {set x(0)} msg] $msg]
  414. } {0 zzz 0 zzz}
  415. test trace-8.3 {array elements are unset before traces are called} {
  416.     catch {unset x}
  417.     set x(0) 33
  418.     set info {}
  419.     trace var x(0) u {traceCheck {global x; trace vinfo x(0)}}
  420.     unset x(0)
  421.     set info
  422. } {0 {}}
  423. test trace-8.4 {set new array element trace during unset trace} {
  424.     catch {unset x}
  425.     set x(0) 33
  426.     set info {}
  427.     trace var x(0) u {traceCheck {uplevel {trace variable x(0) r {}}}}
  428.     catch {unset x(0)}
  429.     concat $info [trace vinfo x(0)]
  430. } {0 {} {r {}}}
  431.  
  432. test trace-9.1 {make sure arrays are unset before traces are called} {
  433.     catch {unset x}
  434.     set x(0) 33
  435.     set info {}
  436.     trace var x u {traceCheck {uplevel set x(0)}}
  437.     unset x
  438.     set info
  439. } {1 {can't read "x(0)": no such variable}}
  440. test trace-9.2 {make sure arrays are unset before traces are called} {
  441.     catch {unset x}
  442.     set x(y) 33
  443.     set info {}
  444.     trace var x u {traceCheck {uplevel set x(y) 22}}
  445.     unset x
  446.     concat $info [list [catch {set x(y)} msg] $msg]
  447. } {0 22 0 22}
  448. test trace-9.3 {make sure arrays are unset before traces are called} {
  449.     catch {unset x}
  450.     set x(y) 33
  451.     set info {}
  452.     trace var x u {traceCheck {uplevel array names x}}
  453.     unset x
  454.     set info
  455. } {1 {"x" isn't an array}}
  456. test trace-9.4 {make sure arrays are unset before traces are called} {
  457.     catch {unset x}
  458.     set x(y) 33
  459.     set info {}
  460.     set cmd {traceCheck {uplevel {trace vinfo x}}}
  461.     trace var x u $cmd
  462.     unset x
  463.     set info
  464. } {0 {}}
  465. test trace-9.5 {set new array trace during unset trace} {
  466.     catch {unset x}
  467.     set x(y) 33
  468.     set info {}
  469.     trace var x u {traceCheck {global x; trace var x r {}}}
  470.     unset x
  471.     concat $info [trace vinfo x]
  472. } {0 {} {r {}}}
  473. test trace-9.6 {create scalar during array unset trace} {
  474.     catch {unset x}
  475.     set x(y) 33
  476.     set info {}
  477.     trace var x u {traceCheck {global x; set x 44}}
  478.     unset x
  479.     concat $info [list [catch {set x} msg] $msg]
  480. } {0 44 0 44}
  481.  
  482. # Check special conditions (e.g. errors) in Tcl_TraceVar2.
  483.  
  484. test trace-10.1 {creating array when setting variable traces} {
  485.     catch {unset x}
  486.     set info {}
  487.     trace var x(0) w traceProc
  488.     list [catch {set x 22} msg] $msg
  489. } {1 {can't set "x": variable is array}}
  490. test trace-10.2 {creating array when setting variable traces} {
  491.     catch {unset x}
  492.     set info {}
  493.     trace var x(0) w traceProc
  494.     list [catch {set x(0)} msg] $msg
  495. } {1 {can't read "x(0)": no such element in array}}
  496. test trace-10.3 {creating array when setting variable traces} {
  497.     catch {unset x}
  498.     set info {}
  499.     trace var x(0) w traceProc
  500.     set x(0) 22
  501.     set info
  502. } {x 0 w}
  503. test trace-10.4 {creating variable when setting variable traces} {
  504.     catch {unset x}
  505.     set info {}
  506.     trace var x w traceProc
  507.     list [catch {set x} msg] $msg
  508. } {1 {can't read "x": no such variable}}
  509. test trace-10.5 {creating variable when setting variable traces} {
  510.     catch {unset x}
  511.     set info {}
  512.     trace var x w traceProc
  513.     set x 22
  514.     set info
  515. } {x {} w}
  516. test trace-10.6 {creating variable when setting variable traces} {
  517.     catch {unset x}
  518.     set info {}
  519.     trace var x w traceProc
  520.     set x(0) 22
  521.     set info
  522. } {x 0 w}
  523. test trace-10.7 {create array element during read trace} {
  524.     catch {unset x}
  525.     set x(2) zzz
  526.     trace var x r {traceCrtElement xyzzy}
  527.     list [catch {set x(3)} msg] $msg
  528. } {0 xyzzy}
  529. test trace-10.8 {errors when setting variable traces} {
  530.     catch {unset x}
  531.     set x 44
  532.     list [catch {trace var x(0) w traceProc} msg] $msg
  533. } {1 {can't trace "x(0)": variable isn't array}}
  534.  
  535. # Check deleting one trace from another.
  536.  
  537. test trace-11.1 {delete one trace from another} {
  538.     proc delTraces {args} {
  539.     global x
  540.     trace vdel x r {traceTag 2}
  541.     trace vdel x r {traceTag 3}
  542.     trace vdel x r {traceTag 4}
  543.     }
  544.     catch {unset x}
  545.     set x 44
  546.     set info {}
  547.     trace var x r {traceTag 1}
  548.     trace var x r {traceTag 2}
  549.     trace var x r {traceTag 3}
  550.     trace var x r {traceTag 4}
  551.     trace var x r delTraces 
  552.     trace var x r {traceTag 5}
  553.     set x
  554.     set info
  555. } {5 1}
  556.  
  557. # Check operation and syntax of "trace" command.
  558.  
  559. test trace-12.1 {trace command (overall)} {
  560.     list [catch {trace} msg] $msg
  561. } {1 {too few args: should be "trace option [arg arg ...]"}}
  562. test trace-12.2 {trace command (overall)} {
  563.     list [catch {trace gorp} msg] $msg
  564. } {1 {bad option "gorp": should be variable, vdelete, or vinfo}}
  565. test trace-12.3 {trace command ("variable" option)} {
  566.     list [catch {trace variable x y} msg] $msg
  567. } {1 {wrong # args: should be "trace variable name ops command"}}
  568. test trace-12.4 {trace command ("variable" option)} {
  569.     list [catch {trace var x y z z2} msg] $msg
  570. } {1 {wrong # args: should be "trace variable name ops command"}}
  571. test trace-12.5 {trace command ("variable" option)} {
  572.     list [catch {trace var x y z} msg] $msg
  573. } {1 {bad operations "y": should be one or more of rwu}}
  574. test trace-12.6 {trace command ("vdelete" option)} {
  575.     list [catch {trace vdelete x y} msg] $msg
  576. } {1 {wrong # args: should be "trace vdelete name ops command"}}
  577. test trace-12.7 {trace command ("vdelete" option)} {
  578.     list [catch {trace vdelete x y z foo} msg] $msg
  579. } {1 {wrong # args: should be "trace vdelete name ops command"}}
  580. test trace-12.8 {trace command ("vdelete" option)} {
  581.     list [catch {trace vdelete x y z} msg] $msg
  582. } {1 {bad operations "y": should be one or more of rwu}}
  583. test trace-12.9 {trace command ("vdelete" option)} {
  584.     catch {unset x}
  585.     set info {}
  586.     trace var x w traceProc
  587.     trace vdelete x w traceProc
  588. } {}
  589. test trace-12.10 {trace command ("vdelete" option)} {
  590.     catch {unset x}
  591.     set info {}
  592.     trace var x w traceProc
  593.     trace vdelete x w traceProc
  594.     set x 12345
  595.     set info
  596. } {}
  597. test trace-12.11 {trace command ("vdelete" option)} {
  598.     catch {unset x}
  599.     set info {}
  600.     trace var x w {traceTag 1}
  601.     trace var x w traceProc
  602.     trace var x w {traceTag 2}
  603.     set x yy
  604.     trace vdelete x w traceProc
  605.     set x 12345
  606.     trace vdelete x w {traceTag 1}
  607.     set x foo
  608.     trace vdelete x w {traceTag 2}
  609.     set x gorp
  610.     set info
  611. } {2 x {} w 1 2 1 2}
  612. test trace-12.12 {trace command ("vdelete" option)} {
  613.     catch {unset x}
  614.     set info {}
  615.     trace var x w {traceTag 1}
  616.     trace vdelete x w non_existent
  617.     set x 12345
  618.     set info
  619. } {1}
  620. test trace-12.13 {trace command ("vinfo" option)} {
  621.     list [catch {trace vinfo} msg] $msg]
  622. } {1 {wrong # args: should be "trace vinfo name"]}}
  623. test trace-12.14 {trace command ("vinfo" option)} {
  624.     list [catch {trace vinfo x y} msg] $msg]
  625. } {1 {wrong # args: should be "trace vinfo name"]}}
  626. test trace-12.15 {trace command ("vinfo" option)} {
  627.     catch {unset x}
  628.     trace var x w {traceTag 1}
  629.     trace var x w traceProc
  630.     trace var x w {traceTag 2}
  631.     trace vinfo x
  632. } {{w {traceTag 2}} {w traceProc} {w {traceTag 1}}}
  633. test trace-12.16 {trace command ("vinfo" option)} {
  634.     catch {unset x}
  635.     trace vinfo x
  636. } {}
  637. test trace-12.17 {trace command ("vinfo" option)} {
  638.     catch {unset x}
  639.     trace vinfo x(0)
  640. } {}
  641. test trace-12.18 {trace command ("vinfo" option)} {
  642.     catch {unset x}
  643.     set x 44
  644.     trace vinfo x(0)
  645. } {}
  646. test trace-12.19 {trace command ("vinfo" option)} {
  647.     catch {unset x}
  648.     set x 44
  649.     trace var x w {traceTag 1}
  650.     proc check {} {global x; trace vinfo x}
  651.     check
  652. } {{w {traceTag 1}}}
  653.  
  654. # Check fancy trace commands (long ones, weird arguments, etc.)
  655.  
  656. test trace-13.1 {long trace command} {
  657.     catch {unset x}
  658.     set info {}
  659.     trace var x w {traceTag {This is a very very long argument.  It's \
  660.     designed to test out the facilities of TraceVarProc for dealing \
  661.     with such long arguments by malloc-ing space.  One possibility \
  662.     is that space doesn't get freed properly.  If this happens, then \
  663.     invoking this test over and over again will eventually leak memory.}}
  664.     set x 44
  665.     set info
  666. } {This is a very very long argument.  It's \
  667.     designed to test out the facilities of TraceVarProc for dealing \
  668.     with such long arguments by malloc-ing space.  One possibility \
  669.     is that space doesn't get freed properly.  If this happens, then \
  670.     invoking this test over and over again will eventually leak memory.}
  671. test trace-13.2 {long trace command result to ignore} {
  672.     proc longResult {args} {return "quite a bit of text, designed to
  673.     generate a core leak if this command file is invoked over and over again
  674.     and memory isn't being recycled correctly"}
  675.     catch {unset x}
  676.     trace var x w longResult
  677.     set x 44
  678.     set x 5
  679.     set x abcde
  680. } abcde
  681. test trace-13.3 {special list-handling in trace commands} {
  682.     catch {unset "x y z"}
  683.     set "x y z(a\n\{)" 44
  684.     set info {}
  685.     trace var "x y z(a\n\{)" w traceProc
  686.     set "x y z(a\n\{)" 33
  687.     set info
  688. } "{x y z} a\\n\\{ w"
  689.  
  690. # Check for proper handling of unsets during traces.
  691.  
  692. proc traceUnset {unsetName args} {
  693.     global info
  694.     upvar $unsetName x
  695.     lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg
  696. }
  697. proc traceReset {unsetName resetName args} {
  698.     global info
  699.     upvar $unsetName x $resetName y
  700.     lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg
  701. }
  702. proc traceReset2 {unsetName resetName args} {
  703.     global info
  704.     lappend info [catch {uplevel unset $unsetName} msg] $msg \
  705.         [catch {uplevel set $resetName xyzzy} msg] $msg
  706. }
  707. proc traceAppend {string name1 name2 op} {
  708.     global info
  709.     lappend info $string
  710. }
  711.  
  712. test trace-14.1 {unsets during read traces} {
  713.     catch {unset y}
  714.     set y 1234
  715.     set info {}
  716.     trace var y r {traceUnset y}
  717.     trace var y u {traceAppend unset}
  718.     lappend info [catch {set y} msg] $msg
  719. } {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
  720. test trace-14.2 {unsets during read traces} {
  721.     catch {unset y}
  722.     set y(0) 1234
  723.     set info {}
  724.     trace var y(0) r {traceUnset y(0)}
  725.     lappend info [catch {set y(0)} msg] $msg
  726. } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}}
  727. test trace-14.3 {unsets during read traces} {
  728.     catch {unset y}
  729.     set y(0) 1234
  730.     set info {}
  731.     trace var y(0) r {traceUnset y}
  732.     lappend info [catch {set y(0)} msg] $msg
  733. } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
  734. test trace-14.4 {unsets during read traces} {
  735.     catch {unset y}
  736.     set y 1234
  737.     set info {}
  738.     trace var y r {traceReset y y}
  739.     lappend info [catch {set y} msg] $msg
  740. } {0 {} 0 xyzzy 0 xyzzy}
  741. test trace-14.5 {unsets during read traces} {
  742.     catch {unset y}
  743.     set y(0) 1234
  744.     set info {}
  745.     trace var y(0) r {traceReset y(0) y(0)}
  746.     lappend info [catch {set y(0)} msg] $msg
  747. } {0 {} 0 xyzzy 0 xyzzy}
  748. test trace-14.6 {unsets during read traces} {
  749.     catch {unset y}
  750.     set y(0) 1234
  751.     set info {}
  752.     trace var y(0) r {traceReset y y(0)}
  753.     lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
  754. } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}}
  755. test trace-14.7 {unsets during read traces} {
  756.     catch {unset y}
  757.     set y(0) 1234
  758.     set info {}
  759.     trace var y(0) r {traceReset2 y y(0)}
  760.     lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
  761. } {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy}
  762. test trace-14.8 {unsets during write traces} {
  763.     catch {unset y}
  764.     set y 1234
  765.     set info {}
  766.     trace var y w {traceUnset y}
  767.     trace var y u {traceAppend unset}
  768.     lappend info [catch {set y xxx} msg] $msg
  769. } {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
  770. test trace-14.9 {unsets during write traces} {
  771.     catch {unset y}
  772.     set y(0) 1234
  773.     set info {}
  774.     trace var y(0) w {traceUnset y(0)}
  775.     lappend info [catch {set y(0) xxx} msg] $msg
  776. } {0 {} 1 {can't read "x": no such variable} 0 {}}
  777. test trace-14.10 {unsets during write traces} {
  778.     catch {unset y}
  779.     set y(0) 1234
  780.     set info {}
  781.     trace var y(0) w {traceUnset y}
  782.     lappend info [catch {set y(0) xxx} msg] $msg
  783. } {0 {} 1 {can't read "x": no such variable} 0 {}}
  784. test trace-14.11 {unsets during write traces} {
  785.     catch {unset y}
  786.     set y 1234
  787.     set info {}
  788.     trace var y w {traceReset y y}
  789.     lappend info [catch {set y xxx} msg] $msg
  790. } {0 {} 0 xyzzy 0 xyzzy}
  791. test trace-14.12 {unsets during write traces} {
  792.     catch {unset y}
  793.     set y(0) 1234
  794.     set info {}
  795.     trace var y(0) w {traceReset y(0) y(0)}
  796.     lappend info [catch {set y(0) xxx} msg] $msg
  797. } {0 {} 0 xyzzy 0 xyzzy}
  798. test trace-14.13 {unsets during write traces} {
  799.     catch {unset y}
  800.     set y(0) 1234
  801.     set info {}
  802.     trace var y(0) w {traceReset y y(0)}
  803.     lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
  804. } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}}
  805. test trace-14.14 {unsets during write traces} {
  806.     catch {unset y}
  807.     set y(0) 1234
  808.     set info {}
  809.     trace var y(0) w {traceReset2 y y(0)}
  810.     lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
  811. } {0 {} 0 xyzzy 0 {} 0 xyzzy}
  812. test trace-14.15 {unsets during unset traces} {
  813.     catch {unset y}
  814.     set y 1234
  815.     set info {}
  816.     trace var y u {traceUnset y}
  817.     lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
  818. } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}}
  819. test trace-14.16 {unsets during unset traces} {
  820.     catch {unset y}
  821.     set y(0) 1234
  822.     set info {}
  823.     trace var y(0) u {traceUnset y(0)}
  824.     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
  825. } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}}
  826. test trace-14.17 {unsets during unset traces} {
  827.     catch {unset y}
  828.     set y(0) 1234
  829.     set info {}
  830.     trace var y(0) u {traceUnset y}
  831.     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
  832. } {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}}
  833. test trace-14.18 {unsets during unset traces} {
  834.     catch {unset y}
  835.     set y 1234
  836.     set info {}
  837.     trace var y u {traceReset2 y y}
  838.     lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
  839. } {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
  840. test trace-14.19 {unsets during unset traces} {
  841.     catch {unset y}
  842.     set y(0) 1234
  843.     set info {}
  844.     trace var y(0) u {traceReset2 y(0) y(0)}
  845.     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
  846. } {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
  847. test trace-14.20 {unsets during unset traces} {
  848.     catch {unset y}
  849.     set y(0) 1234
  850.     set info {}
  851.     trace var y(0) u {traceReset2 y y(0)}
  852.     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
  853. } {0 {} 0 xyzzy 0 {} 0 xyzzy}
  854. test trace-14.21 {unsets cancelling traces} {
  855.     catch {unset y}
  856.     set y 1234
  857.     set info {}
  858.     trace var y r {traceAppend first}
  859.     trace var y r {traceUnset y}
  860.     trace var y r {traceAppend third}
  861.     trace var y u {traceAppend unset}
  862.     lappend info [catch {set y} msg] $msg
  863. } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
  864. test trace-14.22 {unsets cancelling traces} {
  865.     catch {unset y}
  866.     set y(0) 1234
  867.     set info {}
  868.     trace var y(0) r {traceAppend first}
  869.     trace var y(0) r {traceUnset y}
  870.     trace var y(0) r {traceAppend third}
  871.     trace var y(0) u {traceAppend unset}
  872.     lappend info [catch {set y(0)} msg] $msg
  873. } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
  874.  
  875. # Check various non-interference between traces and other things.
  876.  
  877. test trace-15.1 {trace doesn't prevent unset errors} {
  878.     catch {unset x}
  879.     set info {}
  880.     trace var x u {traceProc}
  881.     list [catch {unset x} msg] $msg $info
  882. } {1 {can't unset "x": no such variable} {x {} u}}
  883. test trace-15.2 {traced variables must survive procedure exits} {
  884.     catch {unset x}
  885.     proc p1 {} {global x; trace var x w traceProc}
  886.     p1
  887.     trace vinfo x
  888. } {{w traceProc}}
  889. test trace-15.3 {traced variables must survive procedure exits} {
  890.     catch {unset x}
  891.     set info {}
  892.     proc p1 {} {global x; trace var x w traceProc}
  893.     p1
  894.     set x 44
  895.     set info
  896. } {x {} w}
  897.  
  898. # Be sure that procedure frames are released before unset traces
  899. # are invoked.
  900.  
  901. test trace-16.1 {unset traces on procedure returns} {
  902.     proc p1 {x y} {set a 44; p2 14}
  903.     proc p2 {z} {trace var z u {traceCheck {lsort [uplevel {info vars}]}}}
  904.     set info {}
  905.     p1 foo bar
  906.     set info
  907. } {0 {a x y}}
  908.  
  909. # Delete arrays when done, so they can be re-used as scalars
  910. # elsewhere.
  911.  
  912. catch {unset x}
  913. catch {unset y}
  914. concat {}
  915.